home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FM Towns: Free Software Collection 10
/
FM Towns Free Software Collection 10.iso
/
ms_dos
/
lib
/
happysrc
/
pcident.c
< prev
next >
Wrap
Text File
|
1994-02-05
|
8KB
|
253 lines
/*************************************/
/* */
/* *** HAPPy Pascal compiler *** */
/* identifier routine */
/* */
/* Copyright (c) H.Asano 1992,1994.*/
/*************************************/
#define EXTERN extern
#include <string.h>
#include "pascomp.h"
extern void pcerr(int,char*) ; /* エラーメッセージ出力処理 */
extern int crelabel(void) ;
extern void enterstdpf(void) ; /* 標準手続き・関数名の登録処理*/
extern void term(void) ; /* 終了処理 */
extern void *Malloc(int) ; /* メモリ確保処理 */
/**************************************/
/* mkctp() : ctp型のエリアを確保する */
/**************************************/
ctp *mkctp(char *fname,enum idclass fklass,stp *fidtype,ctp *fnext)
{
ctp *lcp ;
lcp = (ctp*)Malloc(sizeof(ctp)) ; /* ctp型エリアを確保 */
strcpy(lcp->name,fname) ; /* 名前の設定 */
lcp->idtype = fidtype ; /* 型の設定 */
lcp->next = fnext ; /* 次へのリンクの設定 */
lcp->klass = fklass ; /* 名前の種類の設定 */
return(lcp) ;
}
/**************************************/
/* enterid() : */
/* identifier を tree に登録 */
/**************************************/
void enterid(ctp *fcp)
{
ctp *lcp;
ctp *lcp1;
aplist *lap ;
boolean lleft ; /* 右か左に登録するかのフラグ lleft=true : 左 */
int cmpresult; /* strcmp の 結果 */
lap = display[top].aname ; /* 定義より先に参照されたか */
while(lap) { /* 調べる */
if(!strcmp(lap->name->name,fcp->name)) {
pcerr(100,fcp->name) ; /* 宣言よりも先に参照された */
return;
}
lap = lap->next ;
}
lcp = display[top].fname;
if(!lcp) {
display[top].fname = fcp ; /* その水準での最初の登録 */
fcp->llink = nil;
fcp->rlink = nil;
return;
}
do {
lcp1 = lcp ;
if(!(cmpresult=strcmp(lcp->name, fcp->name))){/* 既に名前が存在する時 */
pcerr(101,lcp->name); /* 名前の二重定義エラー */
return ; /* 登録せずに打ち切り */
}
else
if(cmpresult < 0) { /* 登録する名前が大きい時*/
lcp = lcp->rlink; /* 右側を探索 */
lleft = false;
}
else { /* 登録する名前が小さい時*/
lcp = lcp->llink; /* 左側を探索 */
lleft = true ;
}
} while (lcp) ;
if(lleft) lcp1->llink = fcp ; /* 左側への登録 */
else lcp1->rlink = fcp; /* 右側への登録 */
fcp->llink = nil;
fcp->rlink = nil;
}
/*****************************************/
/* searchsection() : */
/* identifier を ある水準だけから探す */
/* ・ レコードの名前を処理する場合 */
/* ・ 前方参照された手続き・関数名 */
/*****************************************/
ctp *searchsection(ctp *fcp)
{
int cmpresult; /* strcmp の 結果 */
while(fcp) {
if(!(cmpresult=strcmp(id,fcp->name))) /* 名前が一致した場合 */
return(fcp) ;
fcp = (cmpresult > 0) ? fcp->rlink : fcp->llink ;
}
return(nil) ; /* 見つからない場合 */
}
/**************************************/
/* searchid() : */
/* identifier を 探す */
/**************************************/
ctp *searchid(Set fidcls)
{
ctp *lcp ;
boolean error103 = false ;
int cmpresult; /* strcmp の 結果 */
for(disx=top ; disx>=0 ; disx--) { /* disxは共通変数 */
/* 名前が見つかった水準を示す*/
lcp = display[disx].fname ;
while(lcp) {
if(!(cmpresult=strcmp(id, lcp->name)))/* 名前が一致した */
if(inset(fidcls,lcp->klass)) /* 属性が一致した */
return(lcp) ; /* その時のlcpを返す */
else { /* 名前は一致したが属性が違う */
pcerr(103,id) ; /* 名前の種類が適当でない */
error103 = true ;
break ; /* while loop を抜ける */
}
else
lcp = (cmpresult > 0) ? lcp->rlink : lcp->llink ;
}
}
/* 見つからなかった時はlcp=nilでここに来る */
if(! error103) pcerr(104,id) ; /* 103エラーが出ていなければ
名前が宣言されていないエラーを出す */
/* ポインタ型前方参照ではない時
未定義用のエリアを返却する */
if(inset(fidcls,types)) return(utypptr) ; /* type 型の時 */
if(inset(fidcls,proc )) return(uprcptr) ; /* proc 型の時 */
if(inset(fidcls,vars )) return(uvarptr) ; /* var 型の時 */
if(inset(fidcls,field)) return(ufldptr) ; /* field型の時 */
if(inset(fidcls,konst)) return(ucstptr) ; /* const型の時 */
/* 上記以外=func */ return(ufctptr) ; /* func 型の時 */
}
/**************************************/
/* applied() : 引用名チェーン処理 */
/**************************************/
void applied(ctp *fcp,int ftoplevel)
{
aplist *lap ;
lap = (aplist*)Malloc(sizeof(aplist));
lap->name = fcp ;
lap->next = display[ftoplevel].aname ;
display[ftoplevel].aname = lap ;
}
/***********************************/
/* entdtdnames() : 標準名の登録 */
/***********************************/
void entstdnames(void)
{
ctp *cp;
ctp *cp1;
int i;
char *name;
/**** interger ****/
cp = mkctp("integer",types,intptr,nil) ;
enterid(cp);
/**** real ****/
cp = mkctp("real",types,realptr,nil) ;
enterid(cp);
/**** char ****/
cp = mkctp("char",types,charptr,nil) ;
enterid(cp);
/**** boolean ****/
cp = mkctp("boolean",types,boolptr,nil) ;
enterid(cp);
/**** text ****/
cp = mkctp("text",types,textptr,nil) ;
enterid(cp) ;
/**** false,true ****/
cp1 = nil ;
for(i=0;i<=1;i++) {
name = (i==0) ? "false" : "true";
cp = mkctp(name,konst,boolptr,cp1) ;
cp->n.values.ival = i ; /* false=0; true=1 */
enterid(cp);
cp1 = cp ;
}
boolptr->sf.sc.fconst = cp ;
/**** maxint ****/
cp = mkctp("maxint",konst,intptr,nil) ;
cp->n.values.ival = Maxint ; /* 整数の最大値 */
enterid(cp) ;
/**** 標準手続き・関数の登録 ****/
enterstdpf() ;
}
/**************************************/
/* entdundecl() : */
/* 名前が未定義の時の代用名の登録 */
/**************************************/
void entundecl(void)
{
/**** for types ****/
utypptr = mkctp(" ",types,nil,nil) ;
/**** for const ****/
ucstptr = mkctp(" ",konst,nil,nil) ;
ucstptr->n.values.ival = 0 ;
/**** for vars ****/
uvarptr = mkctp(" ",vars,nil,nil) ;
uvarptr->n.v.vkind = actual ;
uvarptr->n.v.vlev = 0 ;
uvarptr->n.v.vaddr = 0 ;
/**** for field ****/
ufldptr = mkctp(" ",field,nil,nil) ;
ufldptr->n.fldaddr = 0 ;
/**** for procedure ****/
uprcptr = mkctp(" ",proc,nil,nil) ;
uprcptr->n.pf.pfdeckind = declared ;
uprcptr->n.pf.sd.d.pfkind = actual ;
uprcptr->n.pf.sd.d.pflev = 0 ;
uprcptr->n.pf.sd.d.af.a.pfname = crelabel() ;
uprcptr->n.pf.sd.d.af.a.forwdecl = false ;
/**** for function ****/
ufctptr = mkctp(" ",func,nil,nil) ;
ufctptr->n.pf.pfdeckind = declared ;
ufctptr->n.pf.sd.d.pfkind = actual ;
ufctptr->n.pf.sd.d.pflev = 0 ;
ufctptr->n.pf.sd.d.af.a.pfname = crelabel() ;
ufctptr->n.pf.sd.d.af.a.forwdecl = false ;
}